home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #41 (Feb 89) / Forth code / Records.mch next >
Text File  |  1988-12-15  |  5KB  |  194 lines
  1. ( THIS IS A SET OF MACHFORTH ROUTINES FOR BUILDING RECORDS)
  2. ( THEY ALLOW YOU TO BUILD A NAMED RECORD WITH ITEMS OF VARIOUS SIZES )
  3. ( EXECUTING THE RECORD NAME LEAVES THE RECORD SIZE ON THE STACK)
  4. ( EXECUTING AN ITEM NAME LEAVES THE OFFSET OF THE ITEM )
  5. ( INTO THE RECORD ON THE STACK)
  6. ( IT CREATES A TEMPLATE FOR THE RECORD BUT NOT THE ACTUAL RECORD.)
  7. ( CREATE THE RECORD WITH " CREATE <NAME> <RECORD NAME> ALLOT")
  8. ( OR "VARIABLE <NAME> <RECORD NAME> 4 - VALLOT" DEPENDING IF YOU)
  9. ( WANT THE ENTRY IN THE DICTIONARY OR VARIABLE SPACE )
  10.  
  11. VOCABULARY RECORDS ( NEW VOCABULARY )
  12. ALSO RECORDS
  13. DEFINITIONS
  14.  
  15. Global
  16. : Align ( n1 -- [n1] or [n1 + 1] makes n word aligned )
  17.         dup 2 mod + ; ( USED TO WORD ALIGN 2 & 4 BYTE ITEMS )
  18.  
  19. Global
  20. : RECORD ( -- a 0)
  21.          HERE 4 +  CREATE  0 dup W,  DOES>  W@ ;
  22.          ( USED TO OPEN A RECORD )
  23.  
  24. Global
  25. : BYTE: ( a n -- a n1+1)
  26.         CREATE DUP W, 1+ DOES> W@ + ;
  27.  
  28. Global
  29. : BYTES: ( a n1 n2 -- a n1+n2 | AN ARRAY OF n2 bytes ) 
  30.         CREATE OVER Align W, swap Align + DOES> W@ + ;
  31.  
  32. Global
  33. : SHORT: ( a n1  -- a n1+2 | 2 byte integer item )
  34.         CREATE Align DUP W, 2+ DOES> W@ + ;
  35.  
  36. Global
  37. : WORD: ( a n1  -- a n1+2 | 2 byte integer item )
  38.         CREATE Align DUP W, 2+ DOES> W@ + ;
  39.  
  40. Global
  41. : BOOLEAN: ( a n1  -- a n1+2 | 2 byte boolean item )
  42.         CREATE Align DUP W, 2+ DOES> W@ + ;
  43.  
  44. Global
  45. : SHORTS: ( a n1 n2 -- a n1+n2*2 | an array of n2 shorts )
  46.         CREATE OVER Align  W,  2* Swap Align  + DOES> W@ + ;
  47.  
  48. Global
  49. : LONG:  ( a n1  -- a n1+4 | a 4 byte integer )
  50.         CREATE Align DUP W, 4 + DOES> W@ + ;
  51.  
  52. Global
  53. : POINTER:  ( a n1  -- a n1+4 | a 4 byte integer )
  54.         CREATE Align DUP W, 4 + DOES> W@ + ;
  55. Global
  56. : LONGS: ( a n1 n2 -- a n1+n2*4 | an array of n2 4 byte integers )
  57.         CREATE OVER Align  W, 4 * swap Align + DOES> W@ + ;
  58.  
  59. Global
  60. : HANDLE: ( a n1  -- a n1+4 | a handle, 4 byte, item )
  61.         CREATE Align DUP W, 4 + DOES> W@ + ;
  62.  
  63. Global
  64. : HANDLES: ( a n1 n2 -- a n1+n2*4| array of n2 handles )
  65.         CREATE OVER Align  W, 4 * swap Align  + DOES> W@ + ;
  66.  
  67. Global
  68. : ADDR: ( a n1  -- a n1+4 | 4 byte address item, ie pointer )
  69.         CREATE Align DUP W, 4 + DOES> W@ + ;
  70.  
  71. Global
  72. : ADDRS: ( a n1 n2 -- a n1+n2*4 | array of n2 addresses )
  73.         CREATE OVER Align  W, 4 * swap Align + DOES> W@ + ;
  74.  
  75. Global
  76. : RECT: ( a n1 n2 -- a n1+8 | a rect item )
  77.         CREATE Align DUP W, 8 + DOES> W@ + ;
  78.  
  79. Global
  80. : RECTS: ( a n1 n2 -- a n1+n2*8 | an array of n2 rects )
  81.         CREATE  OVER Align  W, 8 * swap Align + DOES> W@ + ;
  82.  
  83. Global
  84. : STRING: ( a n1 n2 -- a n1+n2+1 | a string item n2+1 long ) 
  85.         CREATE OVER W, + 1+ DOES> W@ + ;
  86.  
  87. Global
  88. : RECORD: ( a n1 n2 -- a n1+n2 | a record item of size n2) 
  89.         CREATE OVER Align  W, swap Align + DOES> W@ + ;
  90.  
  91. Global
  92. : END.RECORD { Mainaddr size --|sets size of struct at a to n }
  93.                 Mainaddr W@ Size <
  94.                 IF Size MainAddr W! THen ;
  95.                 ( CLOSES THE RECORD STORES THE RECORD SIZE IN RECORD NAME)
  96.                          
  97. Global
  98. : SUB.REC ( -- )
  99.         CReate  0 W, 2DUP Here 2- Rot Rot DOES> W@ ;
  100.         ( USE TO CREATE A VARIANT RECORD ON THE END OF A RECORD)
  101.  
  102. Global
  103. : END.SUB { SubAddrs MainAddrs Size -- }
  104.         Size SubAddrs W!
  105.         MainAddrs W@ Size <
  106.         IF Size Align MainAddrs W! THen ;
  107.         ( USE TO CLOSE VARIANT RECORD ) 
  108.  
  109. ONLY MAC
  110. ALSO FORTH
  111. DEFINITIONS
  112. ALSO RECORDS
  113.  
  114. Global
  115. RECORD Rectangle
  116.         Global  SHORT: Top
  117.         Global  Short: Left
  118.         Global  Short: Bottom
  119.         Global  SHORT: RIght
  120. ENd.RECORD
  121.  
  122. Global
  123. : rect Variable Rectangle 4 - VALLOT ;
  124. ( CREATES A RECTANGLE RECORD IN THE VARIABLE SPACE )
  125.  
  126.  
  127. ( --------------------------------------------------------------------)
  128. ( USEFUL UTILITIES )
  129.  
  130. Global
  131. : ," ( --- | create a named string )
  132.         34 WORD 
  133.         COUNT DUP C,  
  134.         0 DO
  135.                 DUp i  + C@ C,
  136.         Loop  DRop ;
  137.          ( USE AFTER YOU "CREATE" <NAME>, A NEW DICTIONARY ENTRY)
  138.          ( IT WILL CREATE A NAMED STRING UP TO AN ENDING QUOTE MARK)
  139.          ( EXECUTING <NAME> LEAVES THE ADDRESS OF THE LENGTH BYTE OF STRING)
  140.          ( ie. Create MyStr ," Hello" )
  141.          
  142. Global
  143. CODE @@ ( GETS THE ADDRESS OF DATA IN A HANDLE)
  144.         MOVE.L (A6)+,A0
  145.         MOVE.L (A0),A0
  146.         MOVE.L (A0),-(A6)
  147.         RTS
  148. END-CODE
  149.  
  150. Global
  151. CODE @RECT ( DEREFERENCES A RECTANGLE INTO THE 4 PARAMETERS T/L/B/R)
  152.                 MOVE.L  (A6)+,A0
  153.                 MOVEQ.L  #0,D0
  154.                 MoveQ.L  #0,D1
  155. @STB
  156.                 MOVE.W  0(A0,D1.W),D0
  157.                 EXT.L   D0
  158.                 MOVE.L  D0,-(A6)
  159.                 ADDQ.W  #2,D1
  160.                 CMPI.W  #8,D1
  161.                 BNE.S           @STB
  162.                 RTS
  163. END-CODE
  164.  
  165. Global
  166. CODE R><XY ( T/L/B/R >< X1/Y1/X2/Y2 )
  167.         MOVEM.L         (A6)+,D0-D3
  168.         EXG             D0,D1 
  169.         EXG             D2,D3 
  170.         MOVEM.L         D0-D3,-(A6) 
  171.         RTS
  172. END-CODE
  173.  
  174. Global
  175. CODE <=
  176.         MOVEQ.L #0,D0
  177.         CMPM.L  (A6)+,(A6)+
  178.         BGT.S           @1
  179.         MOVEQ.L #-1,D0
  180. @1      Move.L  D0,-(A6)
  181.         RTS
  182. END-CODE
  183.  
  184. Global
  185. CODE >=
  186.         MOVEQ.L #0,D0
  187.         CMPM.L  (A6)+,(A6)+
  188.         BLT.S           @1
  189.         MOVEQ.L #-1,D0
  190. @1      Move.L  D0,-(A6)
  191.         RTS
  192. END-CODE
  193.